home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / dbaseiii.zip / DBASEIII.PAS < prev   
Pascal/Delphi Source File  |  1993-01-04  |  7KB  |  307 lines

  1. unit dbaseiii;
  2. { unit including procedures for accessing DBaseIII files}
  3.  
  4. interface
  5.  
  6. uses Crt;
  7.  
  8. Procedure OpenDBFData;
  9. Procedure OpenDBFMemo;
  10. Procedure ReadDBFRecord(I : Longint);
  11. Procedure WriteDBFRecord;
  12. Procedure ReadDBFMemo(BlockNumber : integer);
  13. Procedure WriteDBFMemo(var BlockNumberString : string);
  14. Procedure CloseDBFData;
  15. Procedure CloseDBFMemo;
  16.  
  17. const
  18.     DBFMaxRecordLength = 4096;
  19.     DBFMemoBlockLength =  512;
  20.     DBFMaxMemoLength   = 4096;
  21.  
  22. type
  23.     DBFHeaderRec = Record
  24.         HeadType        : byte;
  25.         Year            : byte;
  26.         Month            : byte;
  27.         Day                : byte;
  28.         RecordCount        : longint;
  29.         HeaderLength    : integer;
  30.         RecordSize      : integer;
  31.         Garbage             : array[1..20] of byte;
  32.     end;
  33.  
  34. type
  35.     DBFFieldRec = Record
  36.         FieldName        : array[1..11] of char;
  37.         FieldType        : char;
  38.         Spare1,
  39.         Spare2            : integer;
  40.         Width            : byte;
  41.         Dec                : byte;
  42.         WorkSpace        : array[1..14] of byte;
  43.     end;
  44.  
  45. var
  46.     DBFFileName             : string;
  47.  
  48.     DBFDataFile                : File;
  49.     DBFDataFileAvailable    : boolean;
  50.     DBFBuffer                : array [1..DBFMaxRecordLength] of char;
  51.  
  52.     DBFHeading                : DBFHeaderRec;
  53.  
  54.     DBFField                : DBFFieldRec;
  55.     DBFFieldCount            : integer;
  56.     DBFFieldContent            : array [1..128] of string;
  57.  
  58.     DBFNames                : array [1..128] of string[10];
  59.     DBFLengths                : array [1..128] of byte;
  60.     DBFTypes                : array [1..128] of char;
  61.     DBFDecimals                : array [1..128] of byte;
  62.     DBFContentStart            : array [1..128] of integer;
  63.  
  64.     DBFMemoFile                : File;
  65.     DBFMemoFileAvailable    : boolean;
  66.     DBFMemoBuffer            : Array [1..DBFMemoBlockLength] of byte;
  67.     DBFMemo                    : Array [1..DBFMaxMemoLength] of char;
  68.  
  69.     DBFMemoLength            : integer;
  70.     DBFMemoEnd                : boolean;
  71.     DBFMemoBlock            : integer;
  72.  
  73.     DBFDeleteField            : char;
  74.     DBFFieldStart            : integer;
  75.  
  76.     DBFRecordNumber            : longint;
  77.  
  78. (****************************************************************)
  79.  
  80. implementation
  81.  
  82. (****************************************************************)
  83.  
  84. Procedure ReadDBFHeader;
  85.  
  86. var
  87.     RecordsRead : integer;
  88.  
  89. begin
  90.     BlockRead (DBFDataFile, DBFHeading, SizeOf(DBFHeading), RecordsRead);
  91. end;
  92.  
  93. (*****************************************************************)
  94.  
  95. Procedure ProcessField (F : DBFFieldRec;
  96.                         I : integer);
  97. var
  98.     J : integer;
  99.  
  100. begin
  101.     with F do
  102.     begin
  103.         DBFNames [I] := '';
  104.         J := 1;
  105.         while (J<11) and (FieldName[J] <> #0) do
  106.             begin
  107.                 DBFNames[I] := DBFNames[I] + FieldName [J];
  108.                 J := J + 1;
  109.             end;
  110.         DBFLengths [I]         := Width;
  111.         DBFTypes [I]         := FieldType;
  112.         DBFDecimals [I]     := Dec;
  113.         DBFContentStart [I] := DBFFieldStart;
  114.         DBFFieldStart         := DBFFieldStart + Width;
  115.     end;
  116. end;
  117.  
  118. (***************************************************************)
  119.  
  120. Procedure ReadFields;
  121.  
  122. var
  123.     I             : integer;
  124.     RecordsRead : integer;
  125.  
  126. begin
  127.     Seek(DBFDataFile,32);
  128.     I := 1;
  129.     DBFFieldStart := 2;
  130.     DBFField.FieldName[1] := ' ';
  131.     while (DBFField.FieldName[1] <> #13) do
  132.         begin
  133.             BlockRead(DBFDataFile,DBFField.FieldName[1],1);
  134.             if (DBFField.FieldName[1] <> #13) then
  135.                 begin
  136.                     BlockRead(DBFDataFile, DBFField.FieldName[2],SizeOf(DBFField) - 1, RecordsRead);
  137.                     ProcessField (DBFField, I);
  138.                     I := I + 1;
  139.                 end;
  140.         end;
  141.     DBFFieldCount := I - 1;
  142. end;
  143.  
  144. (***********************************************************)
  145.  
  146. Procedure OpenDBFData;
  147.  
  148. begin
  149.     DBFDataFileAvailable := false;
  150.     Assign(DBFDataFile, DBFFileName+'.DBF');
  151.  
  152. {$I-}
  153.     Reset(DBFDataFile,1);
  154.     If IOResult<>0 then exit;
  155. {$I+}
  156.  
  157.     DBFDataFileAvailable := true;
  158.     Seek(DBFDataFile,0);
  159.     ReadDBFHeader;
  160.     ReadFields;
  161. end;
  162.  
  163. (******************************************************************)
  164.  
  165. Procedure CloseDBFData;
  166.  
  167. begin
  168.     if DBFDataFileAvailable then Close(DBFDataFile);
  169. end;
  170.  
  171. (*******************************************************************)
  172.  
  173. Procedure OpenDBFMemo;
  174.  
  175. begin
  176.     DBFMemoFileAvailable := false;
  177.     Assign(DBFMemoFile, DBFFileName+'.DBT');
  178.  
  179. {$I-}
  180.     Reset(DBFMemoFile,1);
  181.     If IOResult<>0 then exit;
  182. {$I+}
  183.  
  184.     DBFMemoFileAvailable := true;
  185.     Seek(DBFMemoFile,0);
  186. end;
  187.  
  188. (*******************************************************************)
  189.  
  190. Procedure CloseDBFMemo;
  191.  
  192. begin
  193.     If DBFMemoFileAvailable then close(DBFMemoFile);
  194. end;
  195.  
  196. (*******************************************************************)
  197.  
  198. Procedure GetDBFFields;
  199.  
  200. var
  201.     I             : byte;
  202.     J             : integer;
  203.     Response     : string;
  204.  
  205. begin
  206.     DBFDeleteField := DBFBuffer[1];
  207.     For I:=1 to DBFFieldCount do
  208.         begin
  209.             DBFFieldContent[I] := '';
  210.             For J := DBFContentStart[I] to DBFContentStart [I] + DBFLengths[I] -1 do
  211.                 DBFFieldContent[I] := DBFFieldContent[I] + DBFBuffer[J];
  212.             For J := 1 to DBFLengths[I] do
  213.                 if DBFFieldContent[J]=#0 then DBFFieldContent[J]:=#32;
  214.         end;
  215. end;
  216.  
  217. (***********************************************************************)
  218.  
  219. Procedure ReadDBFRecord (I : Longint);
  220.  
  221. var
  222.     RecordsRead : integer;
  223.  
  224. begin
  225.     Seek(DBFDataFile, DBFHeading.HeaderLength + DBFHeading.RecordSize * (I - 1));
  226.     BlockRead (DBFDataFile, DBFBuffer, DBFHeading.RecordSize, RecordsRead);
  227.     GetDBFFields;
  228. end;
  229.  
  230. (**********************************************************************)
  231.  
  232. Procedure ReadDBFMemo(BlockNumber : integer);
  233.  
  234. var
  235.     I             : integer;
  236.     RecordsRead    : word;
  237.  
  238. begin
  239.     DBFMemoLength := 0;
  240.     DBFMemoEnd := false;
  241.     If not DBFMemoFileAvailable then
  242.         begin
  243.             DBFMemoEnd := true;
  244.             exit;
  245.         end;
  246.     FillChar(DBFMemo[1],DBFMaxMemoLength,#0);
  247.     Seek(DBFMemoFile,BlockNumber*DBFMemoBlockLength);
  248.     repeat
  249.         BlockRead(DBFMemoFile,DBFMemoBuffer,DBFMemoBlockLength,RecordsRead);
  250.         For I := 1 to RecordsRead  do
  251.             begin
  252.                 DBFMemoLength := DBFMemoLength + 1;
  253.                 DBFMemo[DBFMemoLength] := chr(DBFMemoBuffer[I] and $7F);
  254.                 If (DBFMemoBuffer[I] = $1A) or (DBFMemoBuffer[I] = $00) then
  255.                     begin
  256.                         DBFMemoEnd := true;
  257.                         DBFMemoLength := DBFMemoLength - 1;
  258.                         exit;
  259.                     end;
  260.             end;
  261.     until DBFMemoEnd;
  262. end;
  263.  
  264. (*********************************************************************)
  265.  
  266. Procedure WriteDBFMemo  {(var BlockNumberString : string)};
  267.  
  268. var
  269.     K : integer;
  270.     ReturnCode : integer;
  271.  
  272. begin
  273.     Val(BlockNumberString,DBFMemoBlock,ReturnCode);
  274.     If ReturnCode>0 then DBFMemoBlock := 0;
  275.     If DBFMemoBlock>0 then
  276.         begin
  277.             Writeln;
  278.             ReadDBFMemo(DBFMemoBlock);
  279.             If DBFMemoLength=0 then exit;
  280.             For K := 1 to DBFMemoLength do
  281.                 Write(DBFMemo[K]);
  282.             WriteLn;
  283.         end;
  284. end;
  285.  
  286. (****************************************************************)
  287.  
  288. Procedure WriteDBFRecord;
  289.  
  290. var
  291.     J : byte;
  292.  
  293. begin
  294.     For J := 1 to DBFFieldCount do
  295.         begin
  296.             Write(DBFNames[J]);
  297.             GoToXY(12,J);
  298.             WriteLn(DBFFieldContent[J]);
  299.             if DBFTypes[J]='M' then WriteDBFMemo(DBFFieldContent[J]);
  300.         end;
  301. end;
  302.  
  303. (*******************************************************************)
  304.  
  305. begin
  306. end.
  307.